##########################################################
# REPLICATING FIGURES & TABLES FOR:

# Giving to the Extreme? Experimental Evidence on Donor Response to Candidate and District Characteristics

# Mellissa Meisels (correspondence: mellissa.b.meisels@vanderbilt.edu), Joshua Clinton, and Gregory Huber
#########################################################
library(data.table)
library(dplyr)
library(tidyverse)
library(sandwich)
library(miceadds)
library(dotwhisker)
library(ggpubr)
library(gridExtra)
library(modelsummary)

# Prep regression formulas
form.binvign <- v_contribute ~ tv_districtchar_leanother + tv_districtchar_leanyour + 
                tv_viab_endorse + tv_viab_money + tv_viab_enthus + tv_viab_primlost + tv_relideo + 
                tv_opponentextreme + tv_opponentincumbent + tv_primary + factor(i.vign)

form.binvign.pid <- v_contribute ~ OwnPID*(tv_districtchar_leanother + tv_districtchar_leanyour + 
                    tv_viab_endorse + tv_viab_money + tv_viab_enthus + tv_viab_primlost + 
                    tv_relideo + tv_opponentextreme + tv_opponentincumbent + tv_primary + factor(i.vign))

# Prep brackets for grouping predictors in coefficient plots
fourbrackets <- list(c("IDEOLOGY\n(omit: same)\n","Somewhat more moderate","Much more extreme"),
                     c("DISTRICT\n(omit: tossup)\n","Leans OTHER party","Leans YOUR party"),
                     c("OPPONENT\n","Extreme\n(vs. typical)","Incumbent\n(vs. challenger)"),
                     c("VIABILITY\n(omit: newcomer)\n","Has key endorsements","Barely lost last time"))

# Prep predictor labels for coefficient plots
relab.pred <- c(tv_relideosomewhatother = "Somewhat more moderate",
                tv_relideosomewhatmore = "Somewhat more extreme",
                tv_relideomuchmore = "Much more extreme",
                tv_districtchar_leanother = "Leans OTHER party",
                tv_districtchar_leanyour = "Leans YOUR party",
                tv_opponentextreme = "Extreme\n(vs. typical)",
                tv_opponentincumbent = "Incumbent\n(vs. challenger)",
                tv_viab_endorse = "Has key endorsements",
                tv_viab_money = "Has raised money",
                tv_viab_enthus = "District enthusiasm",
                tv_viab_primlost = "Barely lost last time",
                tv_primary = "Primary")

setwd() # Set to location of dataset

survey <- fread("GTTE_DonorData.csv")


#### TABLE 1 #### 

  # UNWEIGHTED SAMPLE
prop.table(table(survey$OwnPID))        # Partisanship
prop.table(table(survey$d_networthcat)) # Wealth
prop.table(table(survey$d_education))   # Education
prop.table(table(survey$r_race_white))  # Race
prop.table(table(survey$d_female))      # Gender
prop.table(table(survey$ts_agecat))     # Age
nrow(survey)                            # Total

  # WEIGHTED SAMPLE
survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(OwnPID)) %>%
  group_by(OwnPID) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(OwnPID, pct = (n/sum(n))) # Partisanship

survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(d_networthcat)) %>%
  group_by(d_networthcat) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(d_networthcat, pct = (n/sum(n))) # Wealth

survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(d_education)) %>%
  group_by(d_education) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(d_education, pct = (n/sum(n))) # Education

survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(r_race_white)) %>%
  group_by(r_race_white) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(r_race_white, pct = (n/sum(n))) # Race

survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(d_female)) %>%
  group_by(d_female) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(d_female, pct = (n/sum(n))) # Gender

survey %>% filter(!is.na(PooledDonorInvPropWgt) & !is.na(ts_agecat)) %>%
  group_by(ts_agecat) %>% summarize(n = sum(PooledDonorInvPropWgt)) %>% ungroup() %>%
  reframe(ts_agecat, pct = (n/sum(n))) # Age

survey %>% summarize(n = sum(PooledDonorInvPropWgt, na.rm=T)) # Total


#### Wrangling data to donor-vignette level ####

# Creating separate dataframes for each of the 5 primary and general election vignettes 
v_primary1_dat <- survey %>%
  select_at(vars(!contains(c("2","3","4","5","general")))) %>% # Dropping other vignettes
  rename_with(~ str_remove(., "1")) %>% # Renaming vignette generically
  mutate(i.vign = 1) # Adding indicator for vignette number

v_primary2_dat <- survey %>%
  select_at(vars(!contains(c("1","3","4","5","general")))) %>% 
  rename_with(~ str_remove(., "2")) %>% 
  mutate(i.vign = 2) 

v_primary3_dat <- survey %>%
  select_at(vars(!contains(c("1","2","4","5","general")))) %>% 
  rename_with(~ str_remove(., "3")) %>% 
  mutate(i.vign = 3) 

v_primary4_dat <- survey %>%
  select_at(vars(!contains(c("1","3","2","5","general")))) %>% 
  rename_with(~ str_remove(., "4")) %>% 
  mutate(i.vign = 4) 

v_primary5_dat <- survey %>%
  select_at(vars(!contains(c("1","3","4","2","general")))) %>% 
  rename_with(~ str_remove(., "5")) %>% 
  mutate(i.vign = 5) 

v_general1_dat <- survey %>%
  select_at(vars(!contains(c("2","3","4","5","primary_")))) %>% 
  rename_with(~ str_remove(., "1")) %>% 
  mutate(i.vign = 1) 

v_general2_dat <- survey %>%
  select_at(vars(!contains(c("1","3","4","5","primary_")))) %>% 
  rename_with(~ str_remove(., "2")) %>% 
  mutate(i.vign = 2) 

v_general3_dat <- survey %>%
  select_at(vars(!contains(c("1","2","4","5","primary_")))) %>% 
  rename_with(~ str_remove(., "3")) %>% 
  mutate(i.vign = 3) 

v_general4_dat <- survey %>%
  select_at(vars(!contains(c("1","3","2","5","primary_")))) %>% 
  rename_with(~ str_remove(., "4")) %>% 
  mutate(i.vign = 4) 

v_general5_dat <- survey %>%
  select_at(vars(!contains(c("1","3","4","2","primary_")))) %>% 
  rename_with(~ str_remove(., "5")) %>% 
  mutate(i.vign = 5) 

# Stacking to create donor-vignette-level dataset
l <- list(v_primary1_dat, v_primary2_dat, v_primary3_dat, v_primary4_dat, v_primary5_dat,
          v_general1_dat, v_general2_dat, v_general3_dat, v_general4_dat, v_general5_dat)

v_pooled.bind <- rbindlist(l, use.names=FALSE)

v_pooled.bind <- v_pooled.bind %>%
  rename(v_contribute = v_primary_contribute) %>% # generically named outcome
  mutate(tv_relideo = factor(tv_relideo, # reordering
                             levels = c("same", "somewhatother", "somewhatmore", "muchmore")))


#### FIGURE 1 #### 
v_pooled.bind %>%
  mutate(tv_relideo = factor(tv_relideo, levels = c("somewhatother","same","somewhatmore","muchmore"),
                              labels = c("Somewhat more moderate", "About the same", "Somewhat more extreme","Much more extreme"))) %>%
  group_by(tv_relideo) %>%
  filter(!is.na(PooledDonorInvPropWgt) & !is.na(tv_relideo) & !is.na(v_contribute)) %>%
  summarize(pct_give = sum(v_contribute*PooledDonorInvPropWgt)/sum(PooledDonorInvPropWgt)) %>%
  ggplot(aes(x=tv_relideo, y=pct_give)) + 
  labs(x = "\nRelative Candidate Ideology", y = "Donors Wanting to Contribute\n") +
  geom_bar(stat = "identity", width = .5, fill = "black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0,.4)) +  
  theme_bw() + theme(legend.position = "none")


#### FIGURE 2 ####
lm.pool.vign.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind,
                               weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.bin.coefs <- tidy(lm.pool.vign.bin$lm_res, vcov=lm.pool.vign.bin$vcov) %>% filter(!grepl('factor*', term))

{dwplot(lm.pool.bin.coefs, dodge_size = 0.6,
                            dot_args = list(size = 2.5, pch=1),
                            vline = geom_vline(xintercept = 0, linetype = "dashed")) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.3,.2) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + ylab("") + 
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"),
        axis.text = element_text(size = 12, color = "black"),
        axis.title.x = element_text(size = 15),
        legend.position = c(0.007, 0.01), legend.title = element_blank(),
        legend.margin=margin(-.1,.1,0.05,.1, unit="cm"),
        legend.justification = c(0,0), legend.background = element_rect(colour="grey80"))} %>%
  add_brackets(fourbrackets, fontSize = 1)


#### TABLE 3 #### 
baseline <- lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="(Intercept)"] # Baseline rate
sw_moderate <- lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_relideosomewhatother"] # Coef: somewhat more moderate
sw_extreme <- lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_relideosomewhatmore"] # Coef: somewhat more extreme
mm_extreme <- lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_relideomuchmore"] # Coef: much more extreme
distlean <- (lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_districtchar_leanother"] +
             lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_districtchar_leanyour"]) / 2 # Averaged coef across district lean
oppo_extreme <- lm.pool.bin.coefs$estimate[lm.pool.bin.coefs$term=="tv_opponentextreme"] # Coef: extreme opponent

# Probabilities of giving
baseline + sw_moderate # Somewhat more moderate
baseline + sw_extreme # Somewhat more extreme
baseline + mm_extreme # Much more extreme
baseline + distlean # District leans
baseline + oppo_extreme # Extreme opponent

# Percentage point change from baseline
(baseline + sw_moderate) - baseline # Somewhat more moderate
(baseline + sw_extreme) - baseline # Somewhat more extreme
(baseline + mm_extreme) - baseline # Much more extreme
(baseline + distlean) - baseline # District leans
(baseline + oppo_extreme) - baseline # Extreme opponent

# Percent change from baseline
((baseline + sw_moderate) - baseline) / baseline # Somewhat more moderate
((baseline + sw_extreme) - baseline) / baseline # Somewhat more extreme
((baseline + mm_extreme) - baseline) / baseline # Much more extreme
((baseline + distlean) - baseline) / baseline # District leans
((baseline + oppo_extreme) - baseline) / baseline # Extreme opponent


#### FIGURE 3 #### 

# Share of donors reporting issues > winning
issue.prop <- weighted.mean(survey$e_winissues[!is.na(survey$PooledDonorInvPropWgt)], 
                            w = survey$PooledDonorInvPropWgt[!is.na(survey$PooledDonorInvPropWgt)], na.rm=T)

# Preparing data for plotting
motiv.dat <- data.frame(motive = c("Issues","Winning"), sample = c(rep("", 2)), motiv.prop = c(issue.prop, 1 - issue.prop))

ggplot(motiv.dat, aes(x = sample, y = motiv.prop, fill = motive)) +
  labs(x= "", y = "\nProportion of Respondents") +
  geom_bar(stat="identity", width = .5) +
  scale_y_continuous(labels = c("0%", "25%","50%", "75%","100%")) +
  geom_text(aes(label = motive), position = position_stack(vjust = 0.5), color = c("white","black")) +
  scale_fill_grey() + 
  theme_bw() +theme(legend.position = "none") +coord_flip() 


#### FIGURE 4 #### 
lm.pool.issues.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                 subset = v_pooled.bind$e_winissues==1, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.issues.bin <- tidy(lm.pool.issues.bin$lm_res, vcov=lm.pool.issues.bin$vcov) %>% 
  mutate(model="Issues > Winning") %>% filter(!grepl('factor*', term))

lm.pool.win.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                              subset = v_pooled.bind$e_winissues==0, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.win.bin <- tidy(lm.pool.win.bin$lm_res, vcov=lm.pool.win.bin$vcov) %>% 
  mutate(model="Winning > Issues") %>% filter(!grepl('factor*', term))

motiv.coefs.bin <- rbind(lm.pool.coefs.issues.bin, lm.pool.coefs.win.bin)

{dwplot(motiv.coefs.bin, dot_args = list(aes(shape = model), size=2.5),
                             vline = geom_vline(xintercept = 0, linetype = "dashed"), 
                             dodge_size = .6) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.3,.2) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + ylab("") + 
  scale_shape_manual(limits = c("Winning > Issues", "Issues > Winning"), values = c(1,19)) +
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"),
        axis.text = element_text(size = 12, color = "black"),
        axis.title.x = element_text(size = 15), legend.title = element_blank(),
        legend.margin=margin(-.1,.1,0.05,.1, unit="cm"),legend.background = element_rect(colour="grey80"))} %>%
  add_brackets(fourbrackets, fontSize = 1)


#### FIGURE 5 #### 
v_pooled.bind %>%
  mutate(absPCA = abs(scaledPC), bin = cut(absPCA, seq(min(absPCA),max(absPCA),0.1))) %>%
  filter(!is.na(absPCA) & !is.na(OwnPID) & !is.na(extreme) & !is.na(PooledDonorInvPropWgt)) %>%
  group_by(bin, OwnPID) %>%
  summarize(Percent_Extreme = sum(extreme*PooledDonorInvPropWgt)/sum(PooledDonorInvPropWgt), n = n()) %>%
  ungroup() %>% filter(n > 20) %>%
  mutate(bin_means = (as.numeric(sub("\\((.+),.*", "\\1", bin)) + as.numeric(sub("[^,]*,([^]]*)\\]", "\\1", bin))) / 2) %>%
  ggplot(aes(x=bin_means, y=Percent_Extreme, color = OwnPID)) +
  geom_point() + geom_line() +
  xlab("Abs(Issue-Based Ideology PCA Score)") +
  scale_y_continuous(labels = scales::percent, limits = c(0,1), name = "Self-Identify as Extreme") +
  scale_color_grey(start = .2, end=.7, name = NULL, labels = c("Democrats", "Republicans")) +
  theme_bw()


#### FIGURE 6 #### 

# Self-reported (left plot facet)
lm.pool.xtrem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                subset = v_pooled.bind$extreme==1, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.xtrem.bin <- tidy(lm.pool.xtrem.bin$lm_res, vcov=lm.pool.xtrem.bin$vcov) %>%
  mutate(model="Extreme") %>% filter(!grepl('factor*', term))

lm.pool.noxtrem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                  subset = v_pooled.bind$extreme==0, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.noxtrem.bin <- tidy(lm.pool.noxtrem.bin$lm_res, vcov=lm.pool.noxtrem.bin$vcov) %>%
  mutate(model="Not Extreme") %>% filter(!grepl('factor*', term))

extreme.coefs.bin <- rbind(lm.pool.coefs.noxtrem.bin, lm.pool.coefs.xtrem.bin)

# Issue-based (right plot facet)
v_pooled.bind$ext.pca.dem <- ifelse(v_pooled.bind$OwnPID == "Democrat" &
                                      v_pooled.bind$PC > quantile(v_pooled.bind$PC[v_pooled.bind$OwnPID == "Democrat"], 
                                                                   1-mean(v_pooled.bind$extreme[v_pooled.bind$OwnPID=="Democrat"], na.rm=T)), 1, 0)

v_pooled.bind$ext.pca.rep <- ifelse(v_pooled.bind$OwnPID == "Republican" &
                                      v_pooled.bind$PC < quantile(v_pooled.bind$PC[v_pooled.bind$OwnPID == "Republican"], 
                                                                   mean(v_pooled.bind$extreme[v_pooled.bind$OwnPID=="Republican"], na.rm=T)), 1, 0)

lm.pool.pcaext.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                 subset = v_pooled.bind$ext.pca.dem==1 | v_pooled.bind$ext.pca.rep == 1,
                                 weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.pcaext.bin <- tidy(lm.pool.pcaext.bin$lm_res, vcov=lm.pool.pcaext.bin$vcov) %>%
  mutate(model="Extreme") %>% filter(!grepl('factor*', term))

lm.pool.pcanoext.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                   subset = v_pooled.bind$ext.pca.dem==0 & v_pooled.bind$ext.pca.rep == 0,
                                   weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.pcanoext.bin <- tidy(lm.pool.pcanoext.bin$lm_res, vcov=lm.pool.pcanoext.bin$vcov) %>%
  mutate(model="Not Extreme") %>% filter(!grepl('factor*', term))

pca.coefs.pca.bin <- rbind(lm.pool.coefs.pcanoext.bin, lm.pool.coefs.pcaext.bin)

# Plotting together
extreme.coefplot.self.bin <- dwplot(extreme.coefs.bin, dot_args = list(aes(shape = model), size=2.5),
                                    vline = geom_vline(xintercept = 0, linetype = "dashed"), 
                                    dodge_size = .6) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.3,.2) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + ylab("") + 
  scale_shape_manual(limits = c("Extreme", "Not Extreme"), values = c(1,19)) +
  ggtitle("Self-Reported Extreme Ideology") +
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"), legend.title = element_blank(),
        legend.margin=margin(-.1,.1,0.05,.1, unit="cm"), axis.text = element_text(color="black"), 
        legend.background = element_rect(colour="grey80"))

ideo.legend <- get_legend(extreme.coefplot.self.bin)

extreme.coefplot.self.bin <- extreme.coefplot.self.bin + theme(legend.position = "none")

extreme.coefplot.pca.bin <- dwplot(pca.coefs.pca.bin, dot_args = list(aes(shape = model), size=2.5),
                                   vline = geom_vline(xintercept = 0, linetype = "dashed"), 
                                   dodge_size = .6) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.3,.2) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + ylab("") + 
  ggtitle("Issue-Based Extreme Ideology") +
  scale_shape_manual(limits = c("Extreme", "Not Extreme"), values = c(1,19)) +
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"), legend.title = element_blank(),axis.text = element_text(color="black"), 
        legend.margin=margin(-.1,.1,0.05,.1, unit="cm"), legend.background = element_rect(colour="grey80"))

extreme.coefplot.pca.bin <- extreme.coefplot.pca.bin +theme(legend.position = "none")

extreme.coefplot.self.bin <- {extreme.coefplot.self.bin} %>% add_brackets(fourbrackets)
extreme.coefplot.pca.bin<- {extreme.coefplot.pca.bin} %>% add_brackets(fourbrackets)

grid.arrange(extreme.coefplot.self.bin, extreme.coefplot.pca.bin, bottom = ideo.legend, ncol=2)


#### FIGURE 7 #### 

# Self-reported (left plot facet)
lm.pool.ext.rep.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                  subset = v_pooled.bind$OwnPID=="Republican" & v_pooled.bind$extreme==1,
                                  weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.ext.rep.bin <- tidy(lm.pool.ext.rep.bin$lm_res, vcov=lm.pool.ext.rep.bin$vcov) %>% 
  mutate(model="Extreme Republicans") %>% filter(grepl('tv_relideo*', term))

lm.pool.noext.rep.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                    subset = v_pooled.bind$OwnPID=="Republican" & v_pooled.bind$extreme==0,
                                    weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.noext.rep.bin <- tidy(lm.pool.noext.rep.bin$lm_res, vcov=lm.pool.noext.rep.bin$vcov) %>% 
  mutate(model="Non-Extreme Republicans") %>% filter(grepl('tv_relideo*', term))

lm.pool.ext.dem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                  subset = v_pooled.bind$OwnPID=="Democrat" & v_pooled.bind$extreme==1,
                                  weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.ext.dem.bin <- tidy(lm.pool.ext.dem.bin$lm_res, vcov=lm.pool.ext.dem.bin$vcov) %>% 
  mutate(model="Extreme Democrats") %>% filter(grepl('tv_relideo*', term))

lm.pool.noext.dem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                    subset = v_pooled.bind$OwnPID=="Democrat" & v_pooled.bind$extreme==0,
                                    weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.noext.dem.bin <- tidy(lm.pool.noext.dem.bin$lm_res, vcov=lm.pool.noext.dem.bin$vcov) %>% 
  mutate(model="Non-Extreme Democrats") %>% filter(grepl('tv_relideo*', term))

ideo.pool.coefs.bin <- rbind(lm.pool.coefs.noext.dem.bin, lm.pool.coefs.ext.dem.bin, lm.pool.coefs.noext.rep.bin, lm.pool.coefs.ext.rep.bin)

# Issue-based (right plot facet)
lm.pool.pca.rep.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                  subset = v_pooled.bind$OwnPID=="Republican" & v_pooled.bind$ext.pca.rep==1,
                                  weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.pca.rep.bin <- tidy(lm.pool.pca.rep.bin$lm_res, vcov=lm.pool.pca.rep.bin$vcov) %>% 
  mutate(model="Extreme Republicans") %>% filter(grepl('tv_relideo*', term))

lm.pool.nopca.rep.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                    subset = v_pooled.bind$OwnPID=="Republican" & v_pooled.bind$ext.pca.rep==0,
                                    weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.nopca.rep.bin <- tidy(lm.pool.nopca.rep.bin$lm_res, vcov=lm.pool.nopca.rep.bin$vcov) %>% 
  mutate(model="Non-Extreme Republicans") %>% filter(grepl('tv_relideo*', term))

lm.pool.pca.dem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                  subset = v_pooled.bind$OwnPID=="Democrat" &  v_pooled.bind$ext.pca.dem==1,
                                  weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.pca.dem.bin <- tidy(lm.pool.pca.dem.bin$lm_res, vcov=lm.pool.pca.dem.bin$vcov) %>% 
  mutate(model="Extreme Democrats") %>% filter(grepl('tv_relideo*', term))

lm.pool.nopca.dem.bin <- lm.cluster(form.binvign, cluster = "privateinternalid", data = v_pooled.bind, 
                                    subset = v_pooled.bind$OwnPID=="Democrat" & v_pooled.bind$ext.pca.dem==0,
                                    weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.pool.coefs.nopca.dem.bin <- tidy(lm.pool.nopca.dem.bin$lm_res, vcov=lm.pool.nopca.dem.bin$vcov) %>% 
  mutate(model="Non-Extreme Democrats") %>% filter(grepl('tv_relideo*', term))

pca.pool.coefs.bin <- rbind(lm.pool.coefs.nopca.dem.bin, lm.pool.coefs.pca.dem.bin, lm.pool.coefs.nopca.rep.bin, lm.pool.coefs.pca.rep.bin)

# Plotting together
pool.ideo.coefplot.bin <- dwplot(ideo.pool.coefs.bin, dot_args = list(aes(shape = model),size=2.5),
                                 vline = geom_vline(xintercept = 0, linetype = "dashed"), dodge_size = 0.6) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.35,.25) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + 
  scale_shape_manual(limits = c("Extreme Republicans", "Non-Extreme Republicans", "Extreme Democrats", "Non-Extreme Democrats"), 
                     values=c(1,19,2,17)) +
  ggtitle("Self-Reported Extreme Ideology") +
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"), legend.title = element_blank(),
        axis.text = element_text(color="black"),
        legend.margin=margin(-.1,.1,0.05,.1, unit="cm"),legend.background = element_rect(colour="grey80"))

ideo.party.legend <- get_legend(pool.ideo.coefplot.bin)

pool.ideo.coefplot.bin <- pool.ideo.coefplot.bin + theme(legend.position = "none")

pool.pca.coefplot.bin <- dwplot(pca.pool.coefs.bin, dot_args = list(aes(shape = model),size=2.5),
                                vline = geom_vline(xintercept = 0, linetype = "dashed"), dodge_size = 0.6) %>%
  relabel_predictors(relab.pred) + theme_bw() + xlim(-.35,.25) +
  xlab("\nEffect on Reported Likelihood of Contributing (0-1)") + 
  scale_shape_manual(limits = c("Extreme Republicans", "Non-Extreme Republicans", "Extreme Democrats", "Non-Extreme Democrats"), 
                     values=c(1,19,2,17)) +
  ggtitle("Issue-Based Extreme Ideology") +
  scale_colour_grey(start = .1, end = .1, breaks = c(1,0)) +
  theme(plot.title = element_text(face="bold"),
        legend.position = "none", axis.text = element_text(color = "black"))

grid.arrange(pool.ideo.coefplot.bin, pool.pca.coefplot.bin, bottom = ideo.party.legend, ncol=2)


#### TABLE 4 ####
lm.party.interact <- lm.cluster(form.binvign.pid, cluster = "privateinternalid", data = v_pooled.bind,
                                weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.party.interact.ext <- lm.cluster(form.binvign.pid, cluster = "privateinternalid", data = v_pooled.bind,
                                    subset = v_pooled.bind$extreme==1, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.party.interact.noext <- lm.cluster(form.binvign.pid, cluster = "privateinternalid", data = v_pooled.bind,
                                      subset = v_pooled.bind$extreme==0, weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.party.interact.pca <- lm.cluster(form.binvign.pid, cluster = "privateinternalid", data = v_pooled.bind,
                                    subset = v_pooled.bind$ext.pca.dem==1 | v_pooled.bind$ext.pca.rep==1,
                                    weights = v_pooled.bind$PooledDonorInvPropWgt)

lm.party.interact.nopca <- lm.cluster(form.binvign.pid,  cluster = "privateinternalid", data = v_pooled.bind,
                                      subset = v_pooled.bind$ext.pca.dem==0 & v_pooled.bind$ext.pca.rep==0,
                                      weights = v_pooled.bind$PooledDonorInvPropWgt)

modelsummary(list("All" = lm.party.interact$lm_res,
                  "Self-Reported Extreme" = lm.party.interact.ext$lm_res,
                  "Self-Reported Non-Extreme" = lm.party.interact.noext$lm_res,
                  "Issue-Based Extreme" = lm.party.interact.pca$lm_res,
                  "Issue-Based Non-Extreme" = lm.party.interact.nopca$lm_res),
             stars = c('*' = 0.05, '**' = 0.01, '***' = 0.001),
             coef_omit = "^(?!tv_relideo|OwnPIDRepublican:tv_relideo)", omit = ".*",
             coef_rename = c("tv_relideosomewhatother" = "Somewhat more moderate",
                             "tv_relideosomewhatmore" = "Somewhat more extreme",
                             "tv_relideomuchmore" = "Much more extreme",
                             "OwnPIDRepublican:tv_relideosomewhatother" = "Republican*Somewhat more moderate",
                             "OwnPIDRepublican:tv_relideosomewhatmore" = "Republican*Somewhat more extreme",
                             "OwnPIDRepublican:tv_relideomuchmore" = "Republican*Much more extreme"),
             gof_map = c("nobs", "r.squared"))




